home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 014 (1987-05-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 014 (1987-05-15)(Ossowski, Stefan)(DE)(PD).adf / Cos / xBMAPS / cos.7a < prev    next >
Text File  |  1987-03-04  |  27KB  |  810 lines
  1. '   CIRCLE OF SUCCESS    Steve Michel / Bill Burkhalter  10/8/86
  2. '   2510 16th Ave.  Sterling  IL  61081  815-626-4157
  3.  
  4. main:
  5.   CLS: CLEAR ,30000&: RANDOMIZE TIMER
  6.   ON BREAK GOSUB ctrl.c: BREAK ON
  7.   ON MOUSE GOSUB check.mouse
  8.   ON MENU GOSUB check.menu: MENU ON
  9.   ON TIMER(1) GOSUB beeper
  10.   GOSUB initialize: GOSUB get.datafile: GOSUB get.players
  11. next.game:
  12.   GOSUB reset.vars: GOSUB get.time: GOSUB draw.screen: GOSUB draw.names
  13. next.round:  
  14.   round = round + 1: IF round > num.players THEN final.round
  15.   LOCATE 1,15: FOR j = 1 TO 60: PRINT " ";: NEXT j
  16.   LOCATE 1,2: PRINT "ROUND "; round$(round)
  17.   GOSUB draw.alphabet: GOSUB fix.money: GOSUB get.phrase
  18.   GOSUB draw.boxes: GOSUB check.punc: player = round - 1
  19.   winner.flag = 0
  20. next.player:  
  21.   player = player + 1: IF player > num.players THEN player = 1
  22.   PAINT (moneyx,moneyy),player.color(player),1
  23. main.loop:
  24.   GOSUB same.player: GOSUB check.vowels: IF winner.flag THEN next.round
  25.   MOUSE ON                 
  26.   WHILE MOUSE(0)  = 0: WEND
  27.   WHILE MOUSE(0) <> 1: WEND
  28.   MOUSE OFF
  29.   IF mouse.flag = 0 THEN main.loop
  30.   ON mouse.flag GOSUB spin.wheel, solve.puzzle, buy.vowel
  31.   IF winner.flag THEN next.round
  32.   IF check.flag = 0 THEN next.player
  33.   mouse.flag = 0: GOTO main.loop
  34. END
  35.                  
  36. initialize:
  37.   SCREEN 1,640,200,4,2: WINDOW 1,"  CIRCLE OF SUCCESS  ",,16,1
  38.   GOSUB set.color: CLS: LOCATE 2,1: PRINT " Now initializing....."
  39.   DIM phrase$(200), clue$(200), player$(4), amount(4), bank(4)
  40.   DIM dollar(18), dollar$(18), rotate%(6), round$(4)
  41.   DIM box%(100), blank%(100), inside%(100),light%(100), used%(200)
  42.   DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  43.   blank$="                     ": PI = 3.14159762#
  44.   alpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ": vowel$ = "AEIOU"
  45.   solve.time = 15: type.time = 15: phrases.used = 0
  46.   player.color(1)=3:player.color(2)=2:player.color(3)=15:player.color(4)=12
  47.   GET (15,17)-(30,29),blank%
  48.   LINE (15,17)-(30,29),15,b: GET (15,17)-(30,29),inside%
  49.   PAINT(20,20),14,15: GET (15,17)-(30,29),box%
  50.   PUT (15,17),blank%,AND: xapos = 204: yapos = 165  
  51.   LINE (15,17)-(30,29),15,b: PAINT(20,20),13,15: GET (15,17)-(30,29),light%
  52.   FOR j = 1 TO 4: READ round$(j): NEXT j
  53.   DATA ONE, TWO, THREE, FOUR
  54.   moneyx = 31: moneyy = 161: centerx = 115: centery = 110: aspect = .44
  55.   MENU 1,0,1," ^^ COS ^^ "
  56.   MENU 1,1,1," ABOUT COS "
  57.   MENU 1,2,1," QUIT      "
  58. '  MENU 2,0,1,"": MENU 3,0,1,"": MENU 4,0,1,""
  59. RETURN
  60.  
  61. check.menu:
  62.   IF MENU(0) = 1 THEN GOSUB display
  63.   RETURN
  64.   
  65. set.color:
  66.   'grey, black, green, blue, white, aqua, green, blue, yellow, aqua, red
  67.   'white, aqua, light yellow, dark yellow, red
  68.   PALETTE 0,.5,.5,.5: PALETTE 1,0,0,0: PALETTE 2,0,1,0: PALETTE 3,0,0,1        
  69.   PALETTE 4,1,1,1: PALETTE 5,0,1,1: PALETTE 6,0,1,0: PALETTE 7,0,0,1         
  70.   PALETTE 8,1,.8,.2: PALETTE 9,0,1,1: PALETTE 10,.8,.2,0: PALETTE 11,1,1,1       
  71.   PALETTE 12,0,1,1: PALETTE 13,1,1,.5: PALETTE 14,1,.8,.2: PALETTE 15,.8,.2,0     
  72. RETURN
  73.  
  74. get.players:
  75.   CLS: LOCATE 2,2: INPUT"ENTER NUMBER OF PLAYERS (4 MAX.) ";num.players
  76.   IF num.players < 1 OR num.players > 4 THEN get.players
  77.   CLS: FOR j = 1 TO num.players: LOCATE j*2+2,2: COLOR player.color(j)
  78.      PRINT "Enter name of player #";j;: INPUT player$(j)
  79.      player$(j)=LEFT$(player$(j),11): player$(j)=UCASE$(player$(j))
  80.   NEXT j: COLOR 1,0  
  81. RETURN
  82.  
  83. get.datafile:
  84.   ms$ = "CLICK ON DRIVE FOR COS DISK":GOSUB get.drive:cosdrive$=drive$
  85.   GOSUB check.tab
  86.   ms$ = "CLICK ON DRIVE FOR DATA DISK":GOSUB get.drive:datadrive$=drive$
  87.   CHDIR datadrive$
  88. get.suffix:
  89.   LOCATE 4,27: PRINT "                                          "
  90.   LOCATE 4,22: PRINT "CLICK ON DATA FILE WANTED (A-Z) ";
  91.   GOSUB draw.alphabet: GOSUB click.letter
  92.   datafile$ = "COS.DATAFILE" + letter$ 
  93.   OPEN "R" ,#1, datafile$
  94.   IF LOF(1) > 10 THEN file.ok
  95.   CLOSE #1: KILL datafile$: KILL datafile$+".info"
  96.   CLS: LOCATE 2,27: PRINT "THAT FILE IS NOT ON ";datadrive$
  97.   LOCATE 4,20: PRINT "INSERT CORRECT DISK OR CHECK FILE NAME."
  98.   GOSUB clicker: CLS: GOTO get.suffix
  99. file.ok:
  100.   FIELD #1, 20 AS n$: GET #1,1:num.recs = CVS(n$):CLOSE #1
  101.   ON ERROR GOTO 0
  102. RETURN  
  103.  
  104. reset.vars:
  105.   RESTORE reset.vars: winner.flag = 0: final.flag = 0: round = 0
  106.   beepflag = 0
  107.   FOR j = 1 TO 18: READ dollar(j): NEXT j: clue$ = ""
  108.   DATA 1150,175,800,500,1250,325,750,575,650,925,200,625,475
  109.   DATA 150,675,800,1000,350
  110.   FOR j = 1 TO 6: rotate%(j) = j+5: NEXT j
  111.   FOR j = 1 TO 4: bank(j) = 0: amount(j) = 0: NEXT j
  112.   FOR j = 1 TO 200: used%(j) = 0: NEXT j
  113. RETURN
  114.   
  115. get.time:
  116.   CLS: LOCATE 2,2: PRINT "CURRENT SOLVE TIME = ";solve.time
  117.   LOCATE 4,2: PRINT "CURRENT TYPE TIME  = ";type.time
  118.   title$=" ARE THESE ACCEPTABLE ?": msg$="CLICK ON YES OR NO"
  119.   reqx1=210:reqy1=75:backcol=14:msgcol=1:outcol=15:COLOR 1,0
  120.   CALL REQUESTER: IF choice$="YES" THEN  RETURN
  121.   CLS: LOCATE 2,2: INPUT "ENTER SOLVE TIME => ";solve.time
  122.   LOCATE 4,2: INPUT "ENTER TYPE TIME  => ";type.time
  123.   GOTO get.time
  124.  
  125. draw.screen:
  126.   CLS: delay = 200: COLOR 1,0
  127.   phrase$="CIRCLE":GOSUB draw.boxes:GOSUB display.boxes:GOSUB erase.boxes
  128.   phrase$="OF":GOSUB draw.boxes:GOSUB display.boxes:GOSUB erase.boxes
  129.   phrase$="SUCCESS":GOSUB draw.boxes:GOSUB display.boxes:GOSUB erase.boxes
  130.   pic$ = "cos.screen.pic": GOSUB load.acbm: GOSUB draw.names
  131. RETURN
  132.  
  133. draw.names:
  134.   FOR j = 1 TO num.players: xpos = 40+(j-1)*152
  135.   LINE (xpos-3,28)-(xpos+108,60),1,b
  136.   LINE (xpos-2,28)-(xpos+107,60),1,b
  137.   LINE (xpos-1,29)-(xpos-1,59),player.color(j)
  138.   LINE (xpos+106,29)-(xpos+106,59),player.color(j)
  139.   LINE (xpos,29)-(xpos+105,59),player.color(j),b
  140.   LINE (xpos+1,30)-(xpos+104,58),1,b: LINE (xpos+1,40)-(xpos+104,40),1
  141.   LINE (xpos+2,30)-(xpos+2,58),1: LINE(xpos+103,30)-(xpos+103,58),1
  142.   COLOR player.color(j): LOCATE 5,INT(xpos/8+2): PRINT player$(j);
  143.   NEXT j: GOSUB print.amounts
  144. RETURN
  145.      
  146. draw.alphabet:
  147.   FOR j = 0 TO 25
  148.     PUT (j*16+xapos,yapos),inside%,OR
  149.     LOCATE 22,(j*2+27): PRINT MID$(alpha$,j+1,1);
  150.   NEXT j
  151. RETURN 
  152.  
  153. draw.boxes:
  154.   yppos = 13: length = LEN(phrase$): size = 2*length: start=(80-size)/2
  155.   xppos = (start-2)*8+4
  156.   FOR j = 0 TO length - 1
  157.   IF MID$(phrase$,j+1,1) <> " " THEN
  158.     PUT (j*16+xppos,yppos),box%
  159.   ELSE
  160.     PUT (j*16+xppos,yppos),blank%
  161.   END IF
  162.   NEXT j: LOCATE 1,(40-LEN(clue$)/2): PRINT clue$
  163. RETURN
  164.  
  165. get.phrase:
  166.   phrases.used = phrases.used + 1: 
  167.   IF phrases.used > num.recs THEN
  168.     CLS: LOCATE 2,2: PRINT "ALL THE ITEMS IN THIS FILE HAVE BEEN USED."
  169.     LOCATE 4,2: PRINT "THIS FILE MUST BE RE-USED OR ANOTHER FILE CHOSEN."
  170.     GOSUB get.spacebar
  171.     title$=" WANT TO PLAY AGAIN ?": msg$="CLICK ON YES OR NO"
  172.     reqx1=397:reqy1=77:backcol=14:msgcol=1:outcol=15:COLOR 1,0
  173.     CALL REQUESTER: IF choice$="YES" THEN RUN
  174.     GOTO ctrl.c 
  175.   END IF  
  176.   LOCATE 13,57: PRINT "NOW SELECTING"
  177.   LOCATE 14,57: PRINT "   PUZZLE."
  178.   select = INT(num.recs * RND(1) + 1)
  179.   IF used%(select) = 1 THEN get.phrase
  180.   used%(select) = 1 
  181.   OPEN "R", #1, datafile$
  182.   FIELD #1, 39 AS n$, 20 AS c$
  183.   GET #1, (select + 1)
  184.   phrase$ = n$: clue$ = c$
  185.   FOR un = 1 TO LEN(phrase$)
  186.     MID$(phrase$,un,1) = CHR$((ASC(MID$(phrase$,un,1)) + 13) XOR 13)
  187.   NEXT un
  188.   CLOSE #1
  189.   FOR j = 1 TO 38 
  190.     IF MID$(phrase$,j,2) = "  " THEN 
  191.       phrase$ = LEFT$(phrase$,j-1)
  192.       j = 1E+09
  193.     END IF
  194.   NEXT j  
  195.     FOR j = 1 TO 18 
  196.     IF MID$(clue$,j,2) = "  " THEN 
  197.       clue$ = LEFT$(clue$,j-1)
  198.       j = 1E+09
  199.     END IF
  200.   NEXT j  
  201.   GOSUB erase.msg: used.letter$ = "": keep$ = phrase$
  202. RETURN  
  203.  
  204. erase.msg:
  205.   FOR em = 13 TO 15: LOCATE em,53: PRINT  blank$;: NEXT em
  206. RETURN
  207.  
  208. draw.button:
  209.   LINE (x1,y1)-(x1+85,y1+26),1,b
  210.   LINE (x1+5,y1+3)-(x1+80,y1+23),1,b
  211.   PAINT (x1+1,y1+1),button.color,1
  212.   LINE (x1,y1)-(x1+5,y1+3),1:LINE (x1+85,y1)-(x1+80,y1+3)
  213.   LINE (x1,y1+26)-(x1+5,y1+23),1: LINE (x1+85,y1+26)-(x1+80,y1+23)
  214.   COLOR button.color: LOCATE ybutton, xbutton: PRINT b1$;
  215.   LOCATE ybutton+1,xbutton: PRINT b2$;: COLOR 1,0
  216. RETURN
  217.  
  218. reset.color:
  219.   'blue, white, black, orange
  220.   PALETTE 0,.1,.1,1: PALETTE 1,1,1,1: PALETTE 2,0,0,0: PALETTE 3,.93,.2,0   
  221. RETURN
  222.   
  223. spin.wheel:
  224.   GOSUB erase.msg: numclicks = INT(10*RND(1)+10)
  225.   clicks = INT(6*RND(1)+4): increment = 1100 / clicks 
  226.   delay = 0: LOCATE 22,6: PRINT LEFT$(blank$,18); 
  227. change.palette:
  228.   FOR sw = 1 TO numclicks
  229.    dcount = dcount + 1: IF dcount > 18 THEN dcount = 1
  230.    PALETTE rotate%(1),0,1,0:   PALETTE rotate%(2),0,0,1         
  231.    PALETTE rotate%(3),1,.8,.2: PALETTE rotate%(4),0,1,1         
  232.    PALETTE rotate%(5),.8,.2,0: PALETTE rotate%(6),1,1,1         
  233.    temp = rotate%(6)
  234.    FOR jj = 5 TO 1 STEP -1: rotate%(jj+1) = rotate%(jj): NEXT jj
  235.    rotate%(1) = temp: LOCATE 22,10: PRINT dollar$(dcount);
  236.    SOUND 1000,1,64
  237.   NEXT sw
  238.   numclicks = 1
  239.   delay = delay + increment: FOR kk = 1 TO delay: NEXT kk
  240.   IF delay < 1100 THEN change.palette
  241.   IF dollar$(dcount) = " LOSE TURN " THEN
  242.     check.flag = 0
  243.     RETURN
  244.   END IF  
  245.   IF dollar$(dcount) = " BANKRUPT! " THEN  
  246.     FOR kk = 1900 TO 150 STEP -75: SOUND kk,1: NEXT kk 
  247.     SOUND 140,3: amount(player) = 0: check.flag = 0
  248.     GOSUB print.amounts: RETURN
  249.   END IF
  250.   GOSUB check.consonant: GOSUB check.phrase: IF check.flag = 0 THEN RETURN
  251.   GOSUB print.amounts
  252. RETURN               
  253.  
  254. display.boxes:  
  255.   FOR j = 0 TO LEN(phrase$) - 1
  256.     IF MID$(phrase$,j+1,1) <> " " THEN PUT (j*16+xppos,yppos),inside%,AND
  257.     LOCATE 3,(j*2+start): PRINT MID$(phrase$,j+1,1);
  258.     FOR kk = 1 TO delay: NEXT kk
  259.   NEXT j
  260. RETURN 
  261.  
  262. erase.boxes:  
  263.   FOR j = 0 TO 50: PUT (j*16,yppos),blank%,AND: NEXT j        
  264. RETURN  
  265.   
  266. fix.money:
  267.   FOR j = 1 TO 18 
  268.     IF round = 1 THEN skip.double
  269.     IF RND(1) > .5 THEN dollar(j) = dollar(j) * 2
  270. skip.double:
  271.     dollar$(j) = STR$(dollar(j)): l = (11 - LEN(dollar$(j)))/2
  272.     dollar$(j) = LEFT$(blank$,l)+dollar$(j)+LEFT$(blank$,l)
  273.     dollar$(j) = LEFT$(dollar$(j),11)
  274.   NEXT j
  275.   num.killers = 1: IF round > 1 THEN num.killers = 2
  276.   FOR j = 1 TO num.killers
  277.     x = INT(RND(1)*18+1): dollar$(x) = " BANKRUPT! "
  278.     x = INT(RND(1)*18+1): dollar$(x) = " LOSE TURN "
  279.   NEXT j  
  280.   FOR j = 1 TO num.players: amount(j) = 0: NEXT j: GOSUB print.amounts
  281. RETURN    
  282.  
  283. check.mouse:
  284.   currx = MOUSE(1): curry = MOUSE(2): mouse.flag = 0
  285.   IF currx>251 AND currx<338 AND curry>65 AND curry<93 THEN mouse.flag=1 
  286.   IF currx>251 AND currx<338 AND curry>97 AND curry<125 THEN mouse.flag=2
  287.   IF currx>251 AND currx<338 AND curry>129 AND curry<157 THEN mouse.flag=3
  288.   IF currx>203 AND currx<621 AND curry>164 AND curry<1178 THEN mouse.flag=4
  289. RETURN
  290.  
  291. ctrl.c:
  292.   CLS: FOR j = 1 TO 30: g$ = INKEY$: NEXT j
  293.   GOSUB reset.color: MENU RESET: SCREEN CLOSE 1
  294.   'IF loadacbm = 1 THEN CALL FreeMem&(mybuf&,mybufsize&)
  295.   STOP
  296.  
  297. check.punc:
  298.   LOCATE 13,57: PRINT "CHECKING FOR"
  299.   LOCATE 14,57: PRINT "PUNCTUATION."
  300.   FOR j = 0 TO length - 1
  301.     x$ = MID$(phrase$,j+1,1):x = ASC(x$): IF x$ = " " THEN skip.check
  302.     IF x > 64 AND x < 91 THEN skip.check
  303.     PUT (j*16+xppos,yppos),inside%,AND
  304.     PUT (j*16+xppos,yppos),light%,OR
  305.     SOUND 1900,5: FOR kk = 1 TO 1000: NEXT kk
  306.     PUT (j*16+xppos,yppos),inside%,AND
  307.     LOCATE 3,(j*2+start): PRINT MID$(phrase$,j+1,1);
  308.     MID$(phrase$,j+1,1) = " "
  309. skip.check:
  310.   NEXT j: GOSUB erase.msg
  311. RETURN 
  312.  
  313. print.amounts:
  314.   FOR j = 1 TO num.players: xpos = 40 + (j-1) * 152
  315.     dollar$ = STR$(amount(j))
  316.     dollar$ = LEFT$(blank$,10-LEN(dollar$))+dollar$
  317.     dollar$ = "$" + dollar$
  318.     LOCATE 7,INT(xpos/8+2): COLOR player.color(j): PRINT  dollar$;
  319.   NEXT j: COLOR 1,0  
  320. RETURN   
  321.  
  322. check.consonant:
  323.   GOSUB erase.msg: LOCATE 13,57: PRINT "PLEASE SELECT"
  324.   LOCATE 14,57: PRINT "A CONSONANT.": GOSUB click.letter: vowel.flag = 0
  325.   FOR j = 1 TO LEN(vowel$)
  326.     IF letter$ = MID$(vowel$,j,1) THEN vowel.flag = 1
  327.   NEXT j
  328.   IF vowel.flag THEN 
  329.     LOCATE 13,57: PRINT "CLICK ON A"; 
  330.     LOCATE 14,57: PRINT "CONSONANT,";: LOCATE 15,57: PRINT "PLEASE."
  331.     FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg: GOTO check.consonant
  332.   END IF   
  333.   GOSUB check.used: IF used.flag THEN check.consonant
  334. RETURN
  335.  
  336. check.used: 
  337.   used.flag = 0
  338.   FOR j = 1 TO LEN(used.letter$)
  339.     IF letter$ = MID$(used.letter$,j,1) THEN used.flag = 1
  340.   NEXT j
  341.   IF used.flag THEN
  342.     LOCATE 13,57: PRINT "THAT LETTER"; 
  343.     LOCATE 14,57: PRINT "IS ALREADY";: LOCATE 15,57: PRINT "USED."
  344.     FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg: RETURN
  345.   END IF
  346.   used.letter$ = used.letter$ + letter$ : x = ASC(letter$) - 64
  347.   LOCATE 22,(x-1)*2+27: PRINT " ";
  348. RETURN
  349.  
  350. check.phrase:  
  351.   check.flag = 0
  352.   FOR j = 0 TO LEN(phrase$) - 1  
  353.     IF letter$ <> MID$(phrase$,j+1,1) THEN skip.letter 
  354.     check.flag = 1
  355.     PUT (j*16+xppos,yppos),inside%,AND
  356.     PUT (j*16+xppos,yppos),light%,OR
  357.     SOUND 1900,5: FOR kk = 1 TO 800: NEXT kk
  358.     PUT (j*16+xppos,yppos),inside%,AND
  359.     LOCATE 3,(j*2+start): PRINT MID$(phrase$,j+1,1);
  360.     MID$(phrase$,j+1,1) = " ": IF buy.flag THEN skip.letter
  361.     amount(player) = amount(player) + VAL(dollar$(dcount))
  362. skip.letter: 
  363.   NEXT j   
  364.   IF final.flag THEN RETURN
  365.   IF check.flag = 0 THEN
  366.     LOCATE 13,57: PRINT "THAT LETTER IS"
  367.     LOCATE 14,57: PRINT "NOT IN PUZZLE."
  368.     FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg
  369.   END IF
  370. RETURN  
  371.  
  372. click.letter:
  373.   MOUSE ON
  374.   WHILE MOUSE(0)  = 0: WEND
  375.   WHILE MOUSE(0) <> 1: WEND
  376.   MOUSE OFF
  377.   IF mouse.flag <> 4 THEN click.letter
  378.   GOSUB erase.msg
  379.   IF currx<204 OR currx>620 OR curry<165 OR curry>177 THEN click.letter
  380.   x = currx - 204: x = INT(x/16) + 65: letter$ = CHR$(x)
  381. RETURN
  382.  
  383. same.player:
  384.   LOCATE 22,6: PRINT LEFT$(blank$,18);
  385.   LOCATE 22,6: COLOR player.color(player): PRINT  player$(player) +"'s turn";
  386.   COLOR 2,0:LOCATE 10,35: PRINT "SPIN";
  387.   LOCATE 11,35: PRINT "WHEEL";: COLOR 1,0
  388.   COLOR 1,0: LOCATE 13,57: PRINT "SPIN, SOLVE OR"
  389.   LOCATE 14,57: PRINT "BUY A VOWEL."
  390. RETURN
  391.  
  392. buy.vowel:
  393.   GOSUB erase.msg
  394.   IF amount(player) < 250 THEN 
  395.     LOCATE 13,57: PRINT "YOU DON'T HAVE"
  396.     LOCATE 14,57: PRINT "ENOUGH MONEY."
  397.     FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg: check.flag = 1
  398.     RETURN
  399.   END IF
  400. money.ok:
  401.   LOCATE 13,57: PRINT "PLEASE SELECT"
  402.   LOCATE 14,57: PRINT "A VOWEL."
  403.   GOSUB click.letter: vowel.flag = 0
  404.   FOR j = 1 TO LEN(vowel$)
  405.     IF letter$ = MID$(vowel$,j,1) THEN vowel.flag = 1
  406.   NEXT j
  407.   IF vowel.flag = 0 THEN 
  408.     GOSUB erase.msg: LOCATE 13,57: PRINT "CLICK ON A" 
  409.     LOCATE 14,57: PRINT "VOWEL,": LOCATE 15,57: PRINT "PLEASE."
  410.     FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg: GOTO money.ok
  411.   END IF   
  412.   GOSUB check.used: IF used.flag THEN money.ok
  413.   IF final.flag THEN RETURN
  414.   amount(player) = amount(player) - 250: GOSUB print.amounts
  415.   buy.flag = 1: GOSUB check.phrase: buy.flag = 0 
  416. RETURN  
  417.   
  418. check.vowels:  
  419.   FOR j = 1 TO LEN(phrase$)
  420.     x$ = MID$(phrase$,j,1): IF x$ = " " THEN skip.it
  421.     vowel.flag = 0
  422.     FOR jj = 1 TO 5
  423.       IF x$ = MID$(vowel$,jj,1) THEN vowel.flag = 1
  424.     NEXT jj
  425.     IF vowel.flag = 0 THEN RETURN
  426. skip.it:        
  427.   NEXT j      
  428.  
  429.   FOR j = 1 TO 3: SOUND 1900,4: FOR kk = 1 TO 100: NEXT kk: NEXT j
  430. force.guess:
  431.   GOSUB solve.puzzle
  432.   IF winner.flag THEN RETURN
  433.   player = player + 1: IF player > num.players THEN player = 1
  434.   LOCATE 22,6: PRINT LEFT$(blank$,18);
  435.   LOCATE 22,6: COLOR player.color(player): PRINT  player$(player) +"'s turn";
  436.   PAINT (moneyx,moneyy),player.color(player),1: COLOR 1,0
  437.   GOTO force.guess
  438.  
  439. solve.puzzle:
  440.   GOSUB erase.msg: COLOR player.color(player): winner.flag = 0
  441.   IF vowel.flag THEN
  442.     LOCATE 13,55
  443.     PRINT "ONLY VOWELS LEFT."
  444.   END IF  
  445.   LOCATE 14,55: PRINT "ENTER YOUR GUESS"
  446.   LOCATE 15,55: PRINT "TO THE PUZZLE.": COLOR 1,0
  447.   WINDOW 2,">>>  ENTER GUESS BELOW  <<<",(37,38)-(604,61),0,1
  448.   WINDOW OUTPUT 2:LOCATE 2,1: size = 40:
  449.   IF final.flag THEN TIMER ON
  450.   CALL INPUTSTRING (entry$,size): TIMER OFF
  451.   WINDOW CLOSE 2: WINDOW OUTPUT 1: GOSUB erase.msg
  452.   IF final.flag THEN RETURN               
  453.   IF entry$ = keep$ THEN
  454.     winner.flag = 1
  455.     LOCATE 13,55: PRINT "THAT IS CORRECT !!"
  456.     phrase$ = keep$: delay = 1: GOSUB display.boxes
  457.   ELSE
  458.     check.flag = 0
  459.     LOCATE 13,55: PRINT "SORRY, THAT IS"
  460.     LOCATE 14,55: PRINT "NOT CORRECT."
  461.   END IF
  462.   FOR kk = 1 TO 3000: NEXT kk 
  463.   GOSUB erase.msg
  464.   IF winner.flag THEN
  465.     IF amount(player) = 0 THEN amount(player) = 200
  466.     bank(player) = bank(player) + amount(player)
  467.     GOSUB erase.msg: GOSUB erase.boxes
  468.   END IF  
  469. RETURN
  470.     
  471. final.round:
  472.   CLS: used.letter$ = "": final.flag = 1: winner = 1: amount = bank(1)
  473.   LOCATE 1,2: PRINT "FINAL ROUND"
  474.   FOR j = 2 TO num.players
  475.     IF bank(j) > amount THEN 
  476.       winner = j
  477.       amount = bank(j)
  478.     END IF  
  479.   NEXT j
  480.   GOSUB draw.msgboard: wc = player.color(winner): radius = 100
  481.   LOCATE 13,55: PRINT "ADVANCING TO THE";
  482.   LOCATE 14,55: PRINT "FINAL ROUND";
  483.   FOR j = 1 TO 6: PRINT ".";:FOR kk = 1 TO 400: NEXT kk: NEXT j: COLOR wc
  484.   LOCATE 15,55: PRINT player$(winner);: COLOR 1,0
  485.   FOR kk = 1 TO 3000: NEXT kk: GOSUB erase.msg
  486.   GOSUB get.phrase: GOSUB draw.boxes: GOSUB check.punc: GOSUB draw.alphabet
  487.   CIRCLE (centerx,centery),radius,wc
  488.   LINE (centerx,centery)-(centerx,centery-radius*aspect),wc
  489.   LOCATE 21,12: COLOR 1,14: PRINT " TIMER ": COLOR 1,0
  490.   x2=0: y2=radius*aspect: radius = 99
  491.   final$ = ""
  492.   FOR jj = 1 TO 5
  493.     GOSUB check.consonant
  494.     final$ = final$ + letter$
  495.     LOCATE 18,57+jj*2: PRINT letter$;
  496.   NEXT jj
  497.   GOSUB money.ok: final$ = final$ + letter$: LOCATE 18,69: PRINT letter$;
  498.   GOSUB erase.msg
  499.   FOR jj = 1 TO 6
  500.     letter$ = MID$(final$,jj,1)
  501.     GOSUB check.phrase
  502.   NEXT jj
  503.   GOSUB erase.msg
  504.   LOCATE 13,55: PRINT "PRESS SPACE BAR TO"
  505.   LOCATE 14,55: PRINT "ANSWER PUZZLE. YOU"
  506.   LOCATE 15,55: PRINT "HAVE";solve.time;"SECONDS."
  507.   seconds = 0: time.allowed = solve.time: TIMER ON
  508. get.loop:
  509.   g$ = INKEY$: IF g$ <> " " THEN get.loop
  510.   TIMER STOP
  511.   LINE (centerx,centery)-(centerx+x2,centery-y2),0
  512.   LINE (centerx,centery)-(centerx,centery-radius*aspect),wc
  513.   WINDOW OUTPUT 1: GOSUB erase.msg
  514.   LOCATE 13,55: PRINT "TYPE IN ANSWER TO"
  515.   LOCATE 14,55: PRINT "THE PUZZLE. YOU"
  516.   LOCATE 15,55: PRINT "HAVE";type.time;"SECONDS."
  517.   seconds = 0: vowel.flag = 0: time.allowed = type.time
  518.   beepflag = 0: GOSUB solve.puzzle: IF beepflag THEN times.up
  519.   IF entry$ = keep$ THEN 
  520.     COLOR 1,0: phrase$ = keep$: GOSUB display.boxes
  521.     LOCATE 13,55: PRINT "YOU WIN A NEW CAR!"; 
  522.     FOR j = 1 TO 5: FOR jj = 200 TO 2000 STEP 100: SOUND jj,.4,,0
  523.     NEXT jj: NEXT j
  524.     SCREEN CLOSE 1: SCREEN 1,320,200,5,1: CLS
  525.     pic$="cos.car.pic": GOSUB load.acbm
  526.   ELSE
  527.     LOCATE 13,55: PRINT "SO SORRY."
  528.     SOUND 261,18,,0: FOR jj = 260 TO 130 STEP -20
  529.     SOUND jj,.5,,0: NEXT jj: SOUND 130,30,,0   
  530.     SCREEN CLOSE 1: SCREEN 1,320,200,5,2: CLS
  531.     pic$="cos.car.pic": GOSUB load.acbm
  532.   END IF
  533.   GOTO play.more  
  534.  
  535. draw.msgboard:
  536.   LINE(400,66)-(600,130),1,b:LINE(410,71)-(590,125),1,b:PAINT(405,68),12,1
  537.   LINE(400,66)-(410,71),1: LINE(600,66)-(590,71),1
  538.   LINE(400,130)-(410,125),1:LINE(600,130)-(590,125),1
  539.   LINE(410,90)-(590,90):LINE(410,89)-(590,89):COLOR 12,0:LOCATE 11,57
  540.   PRINT "MESSAGE BOARD";:COLOR 1,0:RETURN
  541.  
  542. beeper:
  543.   seconds = seconds + 1: WINDOW OUTPUT 1: slice = INT(360 / time.allowed)      
  544.   j = slice * seconds: j = 90 - j: jj = j + 2
  545.   x1 = COS(j * PI / 180)*(radius)
  546.   y1 = SIN(j * PI / 180) * aspect * (radius)
  547.   LINE (centerx,centery)-(centerx+x2,centery-y2),0 
  548.   LINE (centerx,centery)-(centerx+x1,centery-y1),wc
  549.   SOUND 1900,1: x2=x1: y2=y1:COLOR 1,14
  550.   LOCATE 22,12: PRINT "  ";time.allowed - seconds;" ";: COLOR 1,0
  551.   IF seconds < time.allowed THEN
  552.     WINDOW OUTPUT 2
  553.   ELSE 
  554.     beepflag = 1 
  555.   END IF
  556.   RETURN
  557.   
  558. times.up:  
  559.   GOSUB erase.msg: radius = 100
  560.   CIRCLE (centerx,centery),radius,14:PAINT (centerx,centery),14,14
  561.   COLOR 1,14
  562.   LOCATE 13,10: PRINT "   SORRY,": LOCATE 15,10: PRINT "TIME'S UP !!"
  563. play.more:
  564.   COLOR 1,0: phrase$ = keep$ 
  565.   GOSUB display.boxes: FOR kk = 1 TO 3000: NEXT kk
  566.   title$=" WANT TO PLAY AGAIN ?": msg$="CLICK ON YES OR NO"
  567.   reqx1=397:reqy1=77:backcol=14:msgcol=1:outcol=15:COLOR 1,0
  568.   CALL REQUESTER: IF choice$="YES" THEN next.game
  569.   GOTO ctrl.c 
  570.   
  571. SUB REQUESTER STATIC:
  572.   SHARED title$, msg$, reqx1, reqy1, backcol, msgcol, outcol, choice$
  573.   reqx2 = reqx1 + 206: reqy2 = reqy1 + 50
  574.   yesx = 23: yesy = 26: nox = 134: noy = yesy
  575.   WINDOW 2,title$,(reqx1,reqy1)-(reqx2,reqy2),0,1   
  576.   WINDOW OUTPUT 2: PAINT (100,20),backcol,1
  577.   msgpad$ = " " + LEFT$(msg$,22) + " ": msglen = LEN(msgpad$)
  578.   xloc = INT((24-msglen)/2) + 1: xline = (xloc-1)*8
  579.   COLOR msgcol,14: LOCATE 2,xloc: PRINT  msgpad$; 
  580.   LINE (xline,7)-(xline+8*msglen-1,7),14
  581.   LINE (yesx,yesy)-(yesx+57,yesy+18),outcol,bf
  582.   COLOR msgcol,14: LOCATE 5,5: PRINT " YES ";
  583.   LINE (32,31)-(71,31),14
  584.   LINE (nox,noy)-(nox+50,noy+18),outcol,bf
  585.   LINE (144,31)-(175,31),14
  586.   LOCATE 5,19: PRINT " NO ";
  587.  
  588. WAITER:
  589.   choice$ = "none"
  590.   WHILE MOUSE(0)  = 0: WEND
  591.   WHILE MOUSE(0) <> 1: WEND
  592.   xpos = MOUSE(3): ypos = MOUSE(4)
  593.   IF ypos < yesy OR ypos > yesy+18 THEN WAITER
  594.   IF xpos >= yesx AND xpos <= yesx+54 THEN choice$ = "YES"
  595.   IF xpos >= nox AND xpos <= nox+48 THEN choice$ = "NO"
  596.   IF choice$ = "none" THEN WAITER
  597.   WINDOW CLOSE 2
  598. END SUB
  599.  
  600. SUB INPUTSTRING (entry$,strlen) STATIC:
  601. SHARED beepflag
  602. input.string:
  603.   g$ = INKEY$: IF g$ <> "" THEN input.string
  604.   entry$ = "": backspace$ = CHR$(8) + "_" + CHR$(8): counter = 0
  605. next.key:  
  606.   PRINT "_";: FOR kk = 1 TO 50: NEXT kk: PRINT backspace$;
  607.   g$ = INKEY$: IF g$ = "" THEN next.key
  608.   g$ = UCASE$(g$): ascii = ASC(g$)
  609.   IF ascii = 13 OR beepflag = 1 THEN leave.sub
  610.   IF ascii = 8 THEN back.up
  611.   IF ascii < 32 OR ascii > 90 THEN next.key
  612.   IF counter = strlen THEN next.key
  613.   PRINT g$;: entry$ = entry$ + g$
  614.   counter = counter + 1: GOTO next.key
  615. back.up:  
  616.   IF entry$ = "" THEN next.key
  617.   PRINT backspace$;:counter = counter - 1
  618.   IF LEN(entry$) < 2 THEN entry$ = "": GOTO next.key
  619.   entry$ = LEFT$(entry$,LEN(entry$)-1): GOTO next.key 
  620. leave.sub:
  621. END SUB
  622.  
  623. display:
  624.   IF MENU(1) = 2 THEN ctrl.c
  625.   CLS: LOCATE 2,25
  626.   PRINT "WELCOME TO CIRCLE OF SUCCESS!": PRINT 
  627.   PRINT "    This program is fully functional as it now stands and is accompanied"
  628.   PRINT "  by a sample data file named COS.DATAFILEA, whick contains 25 phrases."
  629.   PRINT "  To use this file, simply enter the letter 'A' when the program prompts"
  630.   PRINT "  for a filename.": PRINT   
  631.   PRINT "    Full blown data files (A-J) which contain 200 items apiece are now" 
  632.   PRINT "  available, with data files (K-Z) probably ready by the time you read"
  633.  
  634.   PRINT "  this.  A data file generator program is also available if you wish to"
  635.   PRINT "  create data files of your own.  The pre-made data files and/or file "
  636.   PRINT "  generator may be ordered as listed below.  Happy spinning !!!" 
  637.   PRINT 
  638.   PRINT "                   ORDER FROM:  STERLINGWARE  
  639.   PRINT "                                2510 16TH AVE.
  640.   PRINT "                                STERLING   IL  61081
  641.   PRINT "                         ATTN:  STEVE MICHEL
  642.   PRINT 
  643.   PRINT "   DATA FILES              $8.95 each    (specify file name(s), A-Z)
  644.   PRINT "   DATA FILE GENERATOR    $24.95"
  645.  
  646. get.drive:
  647.   CLS: LOCATE 2,((80-LEN(ms$))/2)
  648.   PRINT ms$
  649.   LOCATE 4,36: PRINT "0       1"
  650.   GOSUB clicker: CLS:
  651.   IF MOUSE(3) < 320 THEN
  652.     drive$ = "DF0:"
  653.   ELSE
  654.     drive$ = "DF1:"
  655.   END IF
  656.   RETURN
  657.  
  658. check.tab:  
  659.   ON ERROR GOTO check.disk: CHDIR cosdrive$
  660. try.again: 
  661.   OPEN "r" , #1, "checktab"
  662.   IF ERR = 70 THEN try.again
  663.   CLOSE #1: KILL "checktab": ON ERROR GOTO 0
  664.   RETURN
  665.  
  666. clicker:  
  667.   LOCATE 23,30: PRINT "CLICK LEFT MOUSE BUTTON";
  668.   WHILE MOUSE(0) =  0: WEND
  669.   WHILE MOUSE(0) <> 1: WEND
  670.   LOCATE 23,30: PRINT "                        ";
  671. RETURN  
  672.  
  673. check.disk:
  674.   IF ERR = 70 THEN
  675.     CLOSE #1: CLS
  676.     LOCATE 2,20: PRINT "Put write protect tab in covered position."
  677.     GOSUB clicker: CLS: RESUME
  678.   ELSE 
  679.     GOTO ctrl.c
  680.   END IF
  681.  
  682. load.acbm:
  683.   REM -  by Carolyn Scheppner  CBM  04/86 ---  THANKS CAROLYN
  684.   IF loadacbm = 1 THEN skip.declares
  685.   DECLARE FUNCTION xOpen&  LIBRARY
  686.   DECLARE FUNCTION xRead&  LIBRARY
  687.   DECLARE FUNCTION xWrite& LIBRARY
  688.   DECLARE FUNCTION IoErr&  LIBRARY
  689.   DECLARE FUNCTION AllocMem&() LIBRARY
  690.   CHDIR cosdrive$ + "xBMAPS":LIBRARY "dos.library": LIBRARY "exec.library"
  691.   LIBRARY "graphics.library": CHDIR cosdrive$
  692. skip.declares:
  693.   fHandle& = 0: mybuf& = 0: foundBMHD = 0
  694.   foundCMAP = 0: foundCAMG = 0: foundCCRT = 0: foundABIT = 0
  695.   filename$ = pic$ + CHR$(0)
  696.   fHandle& = xOpen&(SADD(filename$),1005)
  697.   ClearPublic& = 65537&: mybufsize& = 360
  698.   mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  699.   inbuf& = mybuf&
  700.   cbuf& = mybuf& + 120
  701.   ctab& = mybuf& + 240
  702.   rLen& = xRead&(fHandle&,inbuf&,12)
  703.   tt$ = ""
  704.   FOR kk = 8 TO 11
  705.      tt% = PEEK(inbuf& + kk)
  706.      tt$ = tt$ + CHR$(tt%)
  707.   NEXT
  708. ChunkLoop:
  709.   rLen& = xRead&(fHandle&,inbuf&,8)
  710.   icLen& = PEEKL(inbuf& + 4)
  711.   tt$ = ""
  712.   FOR kk = 0 TO 3
  713.     tt% = PEEK(inbuf& + kk)
  714.     tt$ = tt$ + CHR$(tt%)
  715.   NEXT   
  716.   IF tt$ = "BMHD" THEN  'BitMap header 
  717.     foundBMHD = 1
  718.     rLen& = xRead&(fHandle&,inbuf&,icLen&)
  719.     iWidth%  = PEEKW(inbuf&)
  720.     iHeight% = PEEKW(inbuf& + 2)
  721.     iDepth%  = PEEK(inbuf& + 8)  
  722.     iCompr%  = PEEK(inbuf& + 10)
  723.     scrWidth%  = PEEKW(inbuf& + 16)
  724.     scrHeight% = PEEKW(inbuf& + 18)
  725.     iRowBytes% = iWidth% /8
  726.     scrRowBytes% = scrWidth% / 8
  727.     nColors%  = 2^(iDepth%)
  728.     REM - Enough free ram to display ?
  729.     AvailRam& = FRE(-1)
  730.     NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  731.     IF AvailRam& < NeededRam& THEN
  732.       loadError$ = "Not enough free ram."
  733.       STOP
  734.     END IF
  735.     kk = 1
  736.    IF scrWidth% > 320 THEN kk = kk + 1
  737.    IF scrHeight% > 200  THEN kk = kk + 2
  738.    GOSUB GetScrAddrs
  739.    REM - Black out screen
  740.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  741. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  742.    foundCMAP = 1
  743.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  744.    REM - Build Color Table
  745.    FOR kk = 0 TO nColors% - 1
  746.       red% = PEEK(cbuf&+(kk*3))
  747.       gre% = PEEK(cbuf&+(kk*3)+1)
  748.       blu% = PEEK(cbuf&+(kk*3)+2)
  749.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  750.       POKEW(ctab&+(2*kk)),regTemp%
  751.    NEXT
  752. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  753.    foundCAMG = 1
  754.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  755.    camgModes& = PEEKL(inbuf&)
  756. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  757.    foundCCRT = 1
  758.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  759.    ccrtDir%    = PEEKW(inbuf&)
  760.    ccrtStart%  = PEEK(inbuf& + 2)
  761.    ccrtEnd%    = PEEK(inbuf& + 3)
  762.    ccrtSecs&   = PEEKL(inbuf& + 4)
  763.    ccrtMics&   = PEEKL(inbuf& + 8)
  764. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  765.    foundABIT = 1
  766.    plSize& = (scrWidth%/8) * scrHeight%
  767.    FOR pp = 0 TO iDepth% -1
  768.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  769.    NEXT
  770. ELSE  
  771.    FOR kk = 1 TO icLen&
  772.       rLen& = xRead&(fHandle&,inbuf&,1)
  773.    NEXT
  774.    REM - If odd length, read 1 more byte
  775.    IF (icLen& OR 1) = icLen& THEN 
  776.       rLen& = xRead&(fHandle&,inbuf&,1)
  777.    END IF
  778. END IF
  779. IF foundBMHD AND foundCMAP AND foundABIT THEN
  780.    GOTO GoodLoad
  781. END IF
  782. IF rLen& > 0 THEN GOTO ChunkLoop
  783. GoodLoad:
  784.   loadError$ =""
  785.   IF foundCMAP THEN 
  786.      CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  787.   END IF
  788. cleanup:
  789.   CALL xClose&(fHandle&)
  790.   CALL FreeMem&(mybuf&,mybufsize&)
  791.   loadacbm = 1
  792. RETURN
  793.  
  794. GetScrAddrs:
  795.    sWindow&   = WINDOW(7)
  796.    sScreen&   = PEEKL(sWindow& + 46)
  797.    sViewPort& = sScreen& + 44
  798.    sRastPort& = sScreen& + 84
  799.    sColorMap& = PEEKL(sViewPort& + 4)
  800.    colorTab&  = PEEKL(sColorMap& + 4)
  801.    sBitMap&   = PEEKL(sRastPort& + 4)
  802.    scrWidth%  = PEEKW(sScreen& + 12)
  803.    scrHeight% = PEEKW(sScreen& + 14)
  804.    scrDepth%  = PEEK(sBitMap& + 5)
  805.    nColors%   = 2^scrDepth%
  806.    FOR kk = 0 TO scrDepth% - 1
  807.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  808.    NEXT
  809. RETURN
  810.